home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.003 / stk-3 / stk / 3.1 / STk / Defbutton.stklos < prev    next >
Encoding:
Text File  |  1996-07-29  |  2.0 KB  |  55 lines
  1. ;;;;
  2. ;;;; D e f b u t t o n . s t k       --  Default button composite widget
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  15. ;;;;    Creation date: 22-Mar-1994 13:05
  16. ;;;; Last file update:  2-Jul-1996 12:08
  17.  
  18. (require "Tk-classes")
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ;;;;
  22. ;;;; <Default-button> class definition
  23. ;;;;
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (define-class <Default-button> (<Tk-composite-widget> <Button>)
  27.   ((button        :accessor     button-of)
  28.    (internal-frame :accessor     internal-frame-of)
  29.    ;; Fictive slots 
  30.    (background     :accessor     background
  31.            :init-keyword :background
  32.            :allocation   :propagated
  33.            :propagate-to (frame button internal-frame))
  34.    (border-width   :accessor     border-width 
  35.            :allocation   :propagated
  36.            :init-keyword :border-width
  37.            :propagate-to (frame))
  38.    (relief       :accessor     relief
  39.            :init-keyword :relief
  40.            :allocation   :propagated
  41.            :propagate-to (frame))))
  42.  
  43. (define-method initialize-composite-widget ((self <Default-button>) initargs frame)
  44.   (let* ((if (make <Frame>  :parent frame :border-width 2 :relief "groove"))
  45.      (b  (make <Button> :parent if)))
  46.  
  47.     (pack b  :padx 5 :pady 5 :expand #t)
  48.     (pack if :padx 5 :pady 5 :expand #t)
  49.     
  50.     (slot-set! self 'Id            (Id b))
  51.     (slot-set! self 'button        b)
  52.     (slot-set! self 'internal-frame if)))
  53.  
  54. (provide "Defbutton")
  55.